home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / games1 / maped4.zip / MAPEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-28  |  32KB  |  1,178 lines
  1. {
  2.   MapEdit 4.1     Wolfenstein Map Editor
  3.  
  4.      Copyright (c) 1992  Bill Kirby
  5.  
  6.   ver 4.1a (Dave Huntoon)
  7.             - Adds ability to open Spear of Destiny (SOD) maps.
  8.             - Allows access to objects > 00FE.  Needed for SOD
  9.               objects.
  10.             - minor fix to completely clear text area below
  11.               the map display when the mouse is moved outisde
  12.               of the map area.
  13.  
  14.  
  15. }
  16.  
  17. {$A+,B-,D+,E-,F-,G-,I+,L-,N-,O-,R-,S-,V-,X-}
  18. {$M 16384,0,655360}
  19. program mapedit;
  20.  
  21. uses crt,dos,graph,mouse;
  22.  
  23. const MAP_X = 6;
  24.       MAP_Y = 6;
  25.       TEXTLOC = 460;
  26.  
  27.       GAMEPATH     : string = '.\';
  28.       HEADFILENAME : string = 'maphead';
  29.       MAPFILENAME  : string = 'maptemp';
  30.       LEVELS       : word   = 10;
  31.       GAME_VERSION : real   = 1.0;
  32.  
  33. type data_block = record
  34.        size : word;
  35.        data : pointer;
  36.      end;
  37.  
  38.      level_type = record
  39.        map,
  40.        objects,
  41.        other           : data_block;
  42.        width,
  43.        height          : word;
  44.        name            : string[16];
  45.      end;
  46.  
  47.      grid = array[0..63,0..63] of word;
  48.  
  49.      filltype = (solid,check);
  50.      doortype = (horiz,vert);
  51.  
  52.  
  53. var levelmap,
  54.     objectmap    : grid;
  55.     maps         : array[1..60] of level_type;
  56.  
  57.     show_objects,
  58.     show_floor   : boolean;
  59.  
  60.     mapgraph,
  61.     objgraph     : array[0..511] of string[4];
  62.     mapnames,
  63.     objnames     : array[0..511] of string[20];
  64.  
  65.     themouse  : resetrec;
  66.     mouseloc  : locrec;
  67.  
  68. procedure waitforkey;
  69. var key: char;
  70. begin
  71.   repeat until keypressed;
  72.   key:= readkey;
  73.   if key=#0 then key:= readkey;
  74. end;
  75.  
  76. procedure getkey(var key: char; var control: boolean);
  77. begin
  78.   control:= false;
  79.   key:= readkey;
  80.   if key=#0 then
  81.     begin
  82.       control:= true;
  83.       key:= readkey;
  84.     end;
  85. end;
  86.  
  87. procedure decorate(x,y,c: integer);
  88. var i,j: integer;
  89. begin
  90.   setfillstyle(1,c);
  91.   bar(x*7+MAP_X+2,y*7+MAP_Y+2,x*7+MAP_X+4,y*7+MAP_Y+4);
  92. end;
  93.  
  94. procedure box(fill: filltype; x,y,c1,c2: integer; dec: boolean);
  95. begin
  96.   if fill=solid then
  97.     setfillstyle(1,c1)
  98.   else
  99.     setfillstyle(9,c1);
  100.  
  101.   bar(x*7+MAP_X,y*7+MAP_Y,x*7+6+MAP_X,y*7+6+MAP_Y);
  102.   if dec then decorate(x,y,c2);
  103. end;
  104.  
  105. procedure outtext(x,y,color: integer; s: string);
  106. begin
  107.   setcolor(color);
  108.   outtextxy(x*7+MAP_X,y*7+MAP_Y,s);
  109. end;
  110.  
  111. function hex(x: word): string;
  112. const digit : string[16] = '0123456789ABCDEF';
  113. var temp : string[4];
  114.     i    : integer;
  115. begin
  116.   temp:= '    ';
  117.   for i:= 4 downto 1 do
  118.     begin
  119.       temp[i]:= digit[(x and $000f)+1];
  120.       x:= x div 16;
  121.     end;
  122.   hex:= temp;
  123. end;
  124.  
  125. function hexbyte(x: byte): string;
  126. const digit : string[16] = '0123456789ABCDEF';
  127. var temp : string[4];
  128.     i    : integer;
  129. begin
  130.   temp:= '  ';
  131.   for i:= 2 downto 1 do
  132.     begin
  133.       temp[i]:= digit[(x and $000f)+1];
  134.       x:= x div 16;
  135.     end;
  136.   hexbyte:= temp;
  137. end;
  138.  
  139. procedure doline(x,y,x2,y2: integer);
  140. begin
  141.   line(x+MAP_X,y+MAP_Y,x2+MAP_X,y2+MAP_Y);
  142. end;
  143.  
  144. procedure dobar(x,y,x2,y2: integer);
  145. begin
  146.   bar(x+MAP_Y,y+MAP_Y,x2+MAP_X,y2+MAP_Y);
  147. end;
  148.  
  149. procedure circle(x,y,c1,c2: integer);
  150. const sprite : array[0..6,0..6] of byte =
  151.                    ((0,0,1,1,1,0,0),
  152.                     (0,1,1,1,1,1,0),
  153.                     (1,1,1,2,1,1,1),
  154.                     (1,1,2,2,2,1,1),
  155.                     (1,1,1,2,1,1,1),
  156.                     (0,1,1,1,1,1,0),
  157.                     (0,0,1,1,1,0,0));
  158. var i,j,c: integer;
  159. begin
  160.   for i:= 0 to 6 do
  161.     for j:= 0 to 6 do
  162.       begin
  163.         case sprite[i,j] of
  164.           0: c:=0;
  165.           1: c:=c1;
  166.           2: c:=c2;
  167.         end;
  168.         putpixel(x*7+MAP_X+i,y*7+MAP_Y+j,c);
  169.       end;
  170. end;
  171.  
  172. procedure door(dtype: doortype; x,y,color: integer);
  173. begin
  174.   case dtype of
  175.     vert: begin
  176.             setfillstyle(1,color);
  177.             dobar(x*7+2,y*7,x*7+4,y*7+6);
  178.           end;
  179.     horiz : begin
  180.               setfillstyle(1,color);
  181.               dobar(x*7,y*7+2,x*7+6,y*7+4);
  182.           end;
  183.   end;
  184. end;
  185.  
  186. function hexnibble(c: char): byte;
  187. begin
  188.   case c of
  189.     '0'..'9': hexnibble:= ord(c)-ord('0');
  190.     'a'..'f': hexnibble:= ord(c)-ord('a')+10;
  191.     'A'..'F': hexnibble:= ord(c)-ord('A')+10;
  192.     else hexnibble:= 0;
  193.   end;
  194. end;
  195.  
  196. procedure output(x,y: integer; data: string);
  197. var size  : integer;
  198.     temp  : string[4];
  199.     c1,c2 : byte;
  200. begin
  201.   if data<>'0000' then
  202.     begin
  203.       temp:= data;
  204.       c1:= hexnibble(temp[1]);
  205.       c2:= hexnibble(temp[2]);
  206.       case temp[3] of
  207.         '0': outtext(x,y,c1,temp[4]);
  208.         '1': box(solid,x,y,c1,c2,false);
  209.         '2': box(check,x,y,c1,c2,false);
  210.         '3': box(solid,x,y,c1,c2,true);
  211.         '4': box(check,x,y,c1,c2,true);
  212.         '5': circle(x,y,c1,c2);
  213.         '6': door(horiz,x,y,c1);
  214.         '7': door(vert,x,y,c1);
  215.         '8': begin
  216.                setfillstyle(1,c1);
  217.                dobar(x*7,y*7,x*7+6,y*7+3);
  218.                setfillstyle(1,c2);
  219.                dobar(x*7,y*7+4,x*7+6,y*7+6);
  220.               end;
  221.         '9': putpixel(x*7+MAP_X+3,y*7+MAP_Y+3,c1);
  222.         'a': begin setfillstyle(1,c1); dobar(x*7+2,y*7+1,x*7+4,y*7+5); end;
  223.         'b': begin setfillstyle(1,c1); dobar(x*7+2,y*7+2,x*7+4,y*7+4); end;
  224.         'c': begin setfillstyle(1,c1); dobar(x*7+1,y*7+1,x*7+5,y*7+5); end;
  225.         'd': begin
  226.                setcolor(c1);
  227.                doline(x*7+1,y*7+1,x*7+5,y*7+5);
  228.                doline(x*7+5,y*7+1,x*7+1,y*7+5);
  229.              end;
  230.         'e': begin
  231.                setcolor(c1);
  232.                rectangle(x*7+MAP_X,y*7+MAP_Y,x*7+MAP_X+6,y*7+MAP_Y+6);
  233.              end;
  234.         'f': case c2 of
  235.               2: begin {east}
  236.                    setcolor(c1);
  237.                    doline(x*7,y*7+3,x*7+6,y*7+3);
  238.                    doline(x*7+6,y*7+3,x*7+3,y*7);
  239.                    doline(x*7+6,y*7+3,x*7+3,y*7+6);
  240.                 end;
  241.               0: begin {north}
  242.                    setcolor(c1);
  243.                    doline(x*7+3,y*7+6,x*7+3,y*7);
  244.                    doline(x*7+3,y*7,x*7,y*7+3);
  245.                    doline(x*7+3,y*7,x*7+6,y*7+3);
  246.                  end;
  247.               6: begin {west}
  248.                    setcolor(c1);
  249.                    doline(x*7+6,y*7+3,x*7,y*7+3);
  250.                    doline(x*7,y*7+3,x*7+3,y*7);
  251.                    doline(x*7,y*7+3,x*7+3,y*7+6);
  252.                  end;
  253.               4: begin {south}
  254.                    setcolor(c1);
  255.                    doline(x*7+3,y*7,x*7+3,y*7+6);
  256.                    doline(x*7+3,y*7+6,x*7,y*7+3);
  257.                    doline(x*7+3,y*7+6,x*7+6,y*7+3);
  258.                  end;
  259.               1: begin {northeast}
  260.                    setcolor(c1);
  261.                    doline(x*7,y*7+6,x*7+6,y*7);
  262.                    doline(x*7+6,y*7,x*7+3,y*7);
  263.                    doline(x*7+6,y*7,x*7+6,y*7+3);
  264.                  end;
  265.               7: begin {northwest}
  266.                    setcolor(c1);
  267.                    doline(x*7+6,y*7+6,x*7,y*7);
  268.                    doline(x*7,y*7,x*7+3,y*7);
  269.                    doline(x*7,y*7,x*7,y*7+3);
  270.                  end;
  271.               3: begin {southeast}
  272.                    setcolor(c1);
  273.                    doline(x*7,y*7,x*7+6,y*7+6);
  274.                    doline(x*7+6,y*7+6,x*7+3,y*7+6);
  275.                    doline(x*7+6,y*7+6,x*7+6,y*7+3);
  276.                  end;
  277.               5: begin {southwest}
  278.                    setcolor(c1);
  279.                    doline(x*7+6,y*7,x*7,y*7+6);
  280.                    doline(x*7,y*7+6,x*7+3,y*7+6);
  281.                    doline(x*7,y*7+6,x*7,y*7+3);
  282.                  end;
  283.  
  284.              end;
  285.       end;
  286.     end;
  287. end;
  288.  
  289. procedure display_map;
  290. var i,j: integer;
  291. begin
  292.   j:= 63;
  293.   i:= 0;
  294.   repeat
  295.     setfillstyle(1,0);
  296.     dobar(i*7,j*7,i*7+6,j*7+6);
  297.     if show_floor then
  298.       output(i,j,mapgraph[levelmap[i,j]])
  299.     else
  300.       if not (levelmap[i,j] in [$6a..$8f]) then
  301.         output(i,j,mapgraph[levelmap[i,j]]);
  302.     if show_objects then
  303.       output(i,j,objgraph[objectmap[i,j]]);
  304.     inc(i);
  305.     if i=64 then
  306.       begin
  307.         i:= 0;
  308.         dec(j);
  309.       end;
  310.   until (j<0) or keypressed;
  311. end;
  312.  
  313. procedure read_levels;
  314. var headfile,
  315.     mapfile  : file;
  316.     s,o,
  317.     size     : word;
  318.     idsig    : string[4];
  319.     level    : integer;
  320.     levelptr : longint;
  321.     tempstr  : string[16];
  322.     map_pointer,
  323.     object_pointer,
  324.     other_pointer    : longint;
  325.  
  326. begin
  327.   idsig:= '    ';
  328.   tempstr:= '                ';
  329.   assign(headfile,GAMEPATH+HEADFILENAME);
  330.   {$I-}
  331.   reset(headfile,1);
  332.   {$I+}
  333.   if ioresult<>0 then
  334.     begin
  335.       writeln('error opening ',HEADFILENAME);
  336.       halt(1);
  337.     end;
  338.   assign(mapfile,GAMEPATH+MAPFILENAME);
  339.   {$I-}
  340.   reset(mapfile,1);
  341.   {$I+}
  342.   if ioresult<>0 then
  343.     begin
  344.       writeln('error opening ',MAPFILENAME);
  345.       halt(1);
  346.     end;
  347.  
  348.   for level:= 1 to LEVELS do
  349.     begin
  350.       seek(headfile,2+(level-1)*4);
  351.       blockread(headfile,levelptr,4);
  352.       seek(mapfile,levelptr);
  353.       with maps[level] do
  354.         begin
  355.           blockread(mapfile,map_pointer,4);
  356.           blockread(mapfile,object_pointer,4);
  357.           blockread(mapfile,other_pointer,4);
  358.           blockread(mapfile,map.size,2);
  359.           blockread(mapfile,objects.size,2);
  360.           blockread(mapfile,other.size,2);
  361.           blockread(mapfile,width,2);
  362.           blockread(mapfile,height,2);
  363.           name[0]:=#16;
  364.           blockread(mapfile,name[1],16);
  365.           if GAME_VERSION = 1.1 then
  366.             blockread(mapfile,idsig[1],4);
  367.  
  368.           seek(mapfile,map_pointer);
  369.           getmem(map.data,map.size);
  370.           s:= seg(map.data^);
  371.           o:= ofs(map.data^);
  372.           blockread(mapfile,mem[s:o],map.size);
  373.  
  374.           seek(mapfile,object_pointer);
  375.           getmem(objects.data,objects.size);
  376.           s:= seg(objects.data^);
  377.           o:= ofs(objects.data^);
  378.           blockread(mapfile,mem[s:o],objects.size);
  379.  
  380.           seek(mapfile,other_pointer);
  381.           getmem(other.data,other.size);
  382.           s:= seg(other.data^);
  383.           o:= ofs(other.data^);
  384.           blockread(mapfile,mem[s:o],other.size);
  385.           if GAME_VERSION = 1.0 then
  386.             blockread(mapfile,idsig[1],4);
  387.         end;
  388.     end;
  389.   close(mapfile);
  390.   close(headfile);
  391. end;
  392.  
  393. procedure write_levels;
  394. var headfile,
  395.     mapfile    : file;
  396.     abcd,
  397.     s,o,
  398.     size     : word;
  399.     idsig    : string[4];
  400.     level    : integer;
  401.     levelptr : longint;
  402.     tempstr  : string[16];
  403.     map_pointer,
  404.     object_pointer,
  405.     other_pointer    : longint;
  406.  
  407. begin
  408.   abcd:= $abcd;
  409.   idsig:= '!ID!';
  410.   tempstr:= 'TED5v1.0';
  411.   assign(headfile,GAMEPATH+HEADFILENAME);
  412.   rewrite(headfile,1);
  413.   assign(mapfile,GAMEPATH+MAPFILENAME);
  414.   rewrite(mapfile,1);
  415.  
  416.   blockwrite(headfile,abcd,2);
  417.   blockwrite(mapfile,tempstr[1],8);
  418.   levelptr:= 8;
  419.  
  420.   for level:= 1 to LEVELS do
  421.     begin
  422.       with maps[level] do
  423.         begin
  424.           if GAME_VERSION = 1.1 then
  425.             begin
  426.               map_pointer:= levelptr;
  427.               s:= seg(map.data^);
  428.               o:= ofs(map.data^);
  429.               blockwrite(mapfile,mem[s:o],map.size);
  430.               inc(levelptr,map.size);
  431.  
  432.               object_pointer:= levelptr;
  433.               s:= seg(objects.data^);
  434.               o:= ofs(objects.data^);
  435.               blockwrite(mapfile,mem[s:o],objects.size);
  436.               inc(levelptr,objects.size);
  437.  
  438.               other_pointer:= levelptr;
  439.               s:= seg(other.data^);
  440.               o:= ofs(other.data^);
  441.               blockwrite(mapfile,mem[s:o],other.size);
  442.               inc(levelptr,other.size);
  443.  
  444.               blockwrite(headfile,levelptr,4);
  445.  
  446.               blockwrite(mapfile,map_pointer,4);
  447.               blockwrite(mapfile,object_pointer,4);
  448.               blockwrite(mapfile,other_pointer,4);
  449.               blockwrite(mapfile,map.size,2);
  450.               blockwrite(mapfile,objects.size,2);
  451.               blockwrite(mapfile,other.size,2);
  452.               blockwrite(mapfile,width,2);
  453.               blockwrite(mapfile,height,2);
  454.               name[0]:=#16;
  455.               blockwrite(mapfile,name[1],16);
  456.               inc(levelptr,38);
  457.             end
  458.           else
  459.             begin
  460.               blockwrite(headfile,levelptr,4);
  461.               map_pointer:= levelptr+38;
  462.               object_pointer:= map_pointer+map.size;
  463.               other_pointer:= object_pointer+objects.size;
  464.  
  465.               blockwrite(mapfile,map_pointer,4);
  466.               blockwrite(mapfile,object_pointer,4);
  467.               blockwrite(mapfile,other_pointer,4);
  468.               blockwrite(mapfile,map.size,2);
  469.               blockwrite(mapfile,objects.size,2);
  470.               blockwrite(mapfile,other.size,2);
  471.               blockwrite(mapfile,width,2);
  472.               blockwrite(mapfile,height,2);
  473.               name[0]:=#16;
  474.               blockwrite(mapfile,name[1],16);
  475.  
  476.               s:= seg(map.data^);
  477.               o:= ofs(map.data^);
  478.               blockwrite(mapfile,mem[s:o],map.size);
  479.               s:= seg(objects.data^);
  480.               o:= ofs(objects.data^);
  481.               blockwrite(mapfile,mem[s:o],objects.size);
  482.               s:= seg(other.data^);
  483.               o:= ofs(other.data^);
  484.               blockwrite(mapfile,mem[s:o],other.size);
  485.               inc(levelptr,map.size+objects.size+other.size+38);
  486.             end;
  487.           blockwrite(mapfile,idsig[1],4);
  488.           inc(levelptr,4);
  489.         end;
  490.     end;
  491.   close(mapfile);
  492.   close(headfile);
  493. end;
  494.  
  495. procedure a7a8_expand(src: data_block; var dest: data_block);
  496. var s,o,
  497.     s2,o2,
  498.     index,
  499.     index2,
  500.     size,
  501.     length,
  502.     data,
  503.     newsize  : word;
  504.     goback1  : byte;
  505.     goback2  : word;
  506.     i        : integer;
  507.  
  508. begin
  509.   s:=seg(src.data^);
  510.   o:=ofs(src.data^);
  511.   index:=0;
  512.   move(mem[s:o+index],dest.size,2); inc(index,2);
  513.   getmem(dest.data,dest.size);
  514.   s2:=seg(dest.data^);
  515.   o2:=ofs(dest.data^);
  516.   index2:=0;
  517.  
  518.   repeat
  519.     move(mem[s:o+index],data,2); inc(index,2);
  520.     case hi(data) of
  521.       $a7: begin
  522.              length:=lo(data);
  523.              move(mem[s:o+index],goback1,1); inc(index,1);
  524.              move(mem[s2:o2+index2-goback1*2],mem[s2:o2+index2],length*2);
  525.              inc(index2,length*2);
  526.            end;
  527.       $a8: begin
  528.              length:=lo(data);
  529.              move(mem[s:o+index],goback2,2); inc(index,2);
  530.              move(mem[s2:o2+goback2*2],mem[s2:o2+index2],length*2);
  531.              inc(index2,length*2);
  532.            end;
  533.       else begin
  534.              move(data,mem[s2:o2+index2],2);
  535.              inc(index2,2);
  536.            end;
  537.     end;
  538.   until index=src.size;
  539. end;
  540.  
  541. procedure expand(d: data_block; var g: grid);
  542. var i,x,y : integer;
  543.     s,o,
  544.     data,
  545.     count : word;
  546.     temp  : data_block;
  547. begin
  548.   if GAME_VERSION = 1.1 then
  549.     a7a8_expand(d,temp)
  550.   else
  551.     temp:=d;
  552.  
  553.   x:= 0;
  554.   y:= 0;
  555.   s:= seg(temp.data^);
  556.   o:= ofs(temp.data^);
  557.   inc(o,2);
  558.   while (y<64) do
  559.     begin
  560.       move(mem[s:o],data,2); inc(o,2);
  561.       if data=$abcd then
  562.         begin
  563.           move(mem[s:o],count,2); inc(o,2);
  564.           move(mem[s:o],data,2); inc(o,2);
  565.           for i:= 1 to count do
  566.             begin
  567.               g[x,y]:= data;
  568.               inc(x);
  569.               if x=64 then
  570.                 begin
  571.                   x:= 0;
  572.                   inc(y);
  573.                 end;
  574.             end;
  575.         end
  576.       else
  577.         begin
  578.           g[x,y]:= data;
  579.           inc(x);
  580.           if x=64 then
  581.             begin
  582.               x:= 0;
  583.               inc(y);
  584.             end;
  585.         end;
  586.     end;
  587.   if GAME_VERSION=1.1 then
  588.     freemem(temp.data,temp.size);
  589. end;
  590.  
  591. procedure compress(g: grid; var d: data_block);
  592. var temp     : pointer;
  593.     size: word;
  594.     abcd,
  595.     s,o,
  596.     olddata,
  597.     data,
  598.     nextdata,
  599.     count    : word;
  600.     x,y,i    : integer;
  601.     temp2    : pointer;
  602.  
  603. begin
  604.   abcd:= $abcd;
  605.   x:= 0;
  606.   y:= 0;
  607.   getmem(temp,8194);
  608.   s:= seg(temp^);
  609.   o:= ofs(temp^);
  610.   data:= $2000;
  611.   move(data,mem[s:o],2);
  612.  
  613.   size:= 2;
  614.   data:= g[0,0];
  615.   while (y<64) do
  616.     begin
  617.       count:= 1;
  618.       repeat
  619.         inc(x);
  620.         if x=64 then
  621.           begin
  622.             x:=0;
  623.             inc(y);
  624.           end;
  625.         if y<64 then
  626.           nextdata:= g[x,y];
  627.         inc(count);
  628.       until (nextdata<>data) or (y=64);
  629.       dec(count);
  630.       if count<3 then
  631.         begin
  632.           for i:= 1 to count do
  633.             begin
  634.               move(data,mem[s:o+size],2);
  635.               inc(size,2);
  636.             end;
  637.         end
  638.       else
  639.         begin
  640.           move(abcd,mem[s:o+size],2);
  641.           inc(size,2);
  642.           move(count,mem[s:o+size],2);
  643.           inc(size,2);
  644.           move(data,mem[s:o+size],2);
  645.           inc(size,2);
  646.         end;
  647.       data:= nextdata;
  648.     end;
  649.   getmem(temp2,size);
  650.   move(temp^,temp2^,size);
  651.   freemem(temp,8194);
  652.   if GAME_VERSION = 1.1 then
  653.     begin
  654.       getmem(temp,size+2);
  655.       s:= seg(temp^);
  656.       o:= ofs(temp^);
  657.       move(size,mem[s:o],2);
  658.       move(temp2^,mem[s:o+2],size);
  659.       d.data:=temp;
  660.       d.size:= size+2;
  661.       freemem(temp2,size);
  662.     end
  663.   else
  664.     begin
  665.       d.data:= temp2;
  666.       d.size:= size;
  667.     end;
  668. end;
  669.  
  670. procedure clear_level(n: integer);
  671. var x,y: integer;
  672. begin
  673.    mhide;
  674.    for x:= 0 to 63 do
  675.      for y:= 0 to 63 do
  676.        begin
  677.          levelmap[x,y]:= $8c;
  678.          objectmap[x,y]:= 0;
  679.        end;
  680.    for x:= 0 to 63 do
  681.      begin
  682.        levelmap[x,0]:= 1;
  683.        levelmap[x,63]:= 1;
  684.        levelmap[0,x]:= 1;
  685.        levelmap[63,x]:= 1;
  686.      end;
  687.    display_map;
  688.    mshow;
  689. end;
  690.  
  691. function str_to_hex(s: string): word;
  692. var temp : word;
  693.     i    : integer;
  694. begin
  695.   temp:= 0;
  696.   for i:= 1 to length(s) do
  697.     begin
  698.       temp:= temp * 16;
  699.       case s[i] of
  700.         '0'..'9': temp:= temp + ord(s[i])-ord('0');
  701.         'a'..'f': temp:= temp + ord(s[i])-ord('a')+10;
  702.         'A'..'F': temp:= temp + ord(s[i])-ord('A')+10;
  703.       end;
  704.     end;
  705.   str_to_hex:= temp;
  706. end;
  707.  
  708. procedure showlegend(which,start,n: integer);
  709. var i,x,y: integer;
  710.     save: boolean;
  711. begin
  712.   mhide;
  713.   save:= show_objects;
  714.   show_objects:= true;
  715.   setfillstyle(1,0);
  716.   bar(64*7+MAP_X+13,4,639-5,380-30);
  717.   x:= 66;
  718.   y:= 0;
  719.   for i:= start to start+n-1 do
  720.     begin
  721.       if which=0 then
  722.         begin
  723.           output(x,y,mapgraph[i]);
  724.           outtext(x+2,y,15,mapnames[i]);
  725.         end
  726.       else
  727.         begin
  728.           output(x,y,objgraph[i]);
  729.           outtext(x+2,y,15,objnames[i]);
  730.         end;
  731.       inc(y,2);
  732.     end;
  733.   show_objects:= save;
  734.   mshow;
  735. end;
  736.  
  737. function inside(x1,y1,x2,y2,x,y: integer): boolean;
  738. begin
  739.   inside:= (x>=x1) and (x<=x2) and
  740.            (y>=y1) and (y<=y2);
  741. end;
  742.  
  743. procedure wait_for_mouserelease;
  744. begin
  745.   repeat
  746.     mpos(mouseloc);
  747.   until mouseloc.buttonstatus=0;
  748. end;
  749.  
  750. procedure bevel(x1,y1,x2,y2,c1,c2,c3: integer);
  751. begin
  752.   setfillstyle(1,c1);
  753.   bar(x1,y1,x2,y2);
  754.   setcolor(c2);
  755.   line(x1,y1,x2,y1);
  756.   line(x1+1,y1+1,x2-1,y1+1);
  757.   line(x2,y1,x2,y2);
  758.   line(x2-1,y1,x2-1,y2-1);
  759.   setcolor(c3);
  760.   line(x1,y1+1,x1,y2);
  761.   line(x1+1,y1+2,x1+1,y2);
  762.   line(x1,y2,x2-1,y2);
  763.   line(x1+1,y2-1,x2-2,y2-1);
  764. end;
  765.  
  766. function upper(s: string): string;
  767. var i: integer;
  768. begin
  769.   for i:=1 to length(s) do
  770.     if s[i] in ['a'..'z'] then
  771.       s[i]:=chr(ord(s[i])-ord('a')+ord('A'));
  772.   upper:=s;
  773. end;
  774.  
  775. procedure initialize;
  776. var i: integer;
  777.     infile: text;
  778.  
  779.     path : pathstr;
  780.     dir  : dirstr;
  781.     name : namestr;
  782.     ext  : extstr;
  783.     filename  : string;
  784.     hexstr    : string[4];
  785.     graphstr  : string[4];
  786.     name20    : string[20];
  787.     junk      : char;
  788.     search    : searchrec;
  789.  
  790. begin
  791.   filename:= GAMEPATH + HEADFILENAME + '.*';
  792.   writeln('searching for ',filename);
  793.   findfirst(filename,$ff,search);
  794.   if doserror<>0 then
  795.     begin
  796.       writeln('Error opening ',HEADFILENAME,' file.');
  797.       writeln;
  798.       writeln('Be sure that you installed MAPEDIT in the directory where');
  799.       writeln('Wolfenstein 3-D is installed.');
  800.       halt(0);
  801.     end
  802.   else
  803.     begin
  804.       filename:= search.name;
  805.       fsplit(filename,dir,name,ext);
  806.       HEADFILENAME:= upper(HEADFILENAME+ext);
  807.       if upper(ext)='.SOD' then
  808.           LEVELS:=21;
  809.       if upper(ext)='.WL1' then
  810.           LEVELS:=10;
  811.       if (upper(ext)='.WL1') or (upper(ext)='.SOD') then
  812.         begin
  813.           GAME_VERSION:=1.0;
  814.           MAPFILENAME:='MAPTEMP'+ext;
  815.           filename:=GAMEPATH+'MAPTEMP'+ext;
  816.           findfirst(filename,$ff,search);
  817.           if doserror<>0 then
  818.             begin
  819.               GAME_VERSION:=1.1;
  820.               MAPFILENAME:='GAMEMAPS'+ext;
  821.               filename:=GAMEPATH+'GAMEMAPS'+ext;
  822.               findfirst(filename,$ff,search);
  823.               if doserror<>0 then
  824.                 begin
  825.                   writeln('Error opening GAMEMAPS or MAPTEMP file.');
  826.                   halt(0);
  827.                 end;
  828.             end;
  829.         end;
  830.       if (upper(ext)='.WL3') or (upper(ext)='.WL6') then
  831.         begin
  832.           GAME_VERSION:=1.1;
  833.           if upper(ext)='.WL3' then
  834.             LEVELS:= 30
  835.           else
  836.             LEVELS:= 60;
  837.           MAPFILENAME:='GAMEMAPS'+ext;
  838.           filename:=GAMEPATH+'GAMEMAPS'+ext;
  839.           findfirst(filename,$ff,search);
  840.           if doserror<>0 then
  841.             begin
  842.               writeln('Error opening GAMEMAPS file.');
  843.               halt(0);
  844.             end;
  845.         end;
  846.     end;
  847.  
  848.   for i:= 0 to 511 do
  849.     begin
  850.       mapnames[i]:= 'unknown '+hex(i);
  851.       objnames[i]:= 'unknown '+hex(i);
  852.       mapgraph[i]:= 'f010';
  853.       objgraph[i]:= 'f010';
  854.     end;
  855.   assign(infile,'mapdata.def');
  856.   reset(infile);
  857.   while not eof(infile) do
  858.     begin
  859.       readln(infile,hexstr,junk,graphstr,junk,name20);
  860.       mapnames[str_to_hex(hexstr)]:= name20;
  861.       mapgraph[str_to_hex(hexstr)]:= graphstr;
  862.     end;
  863.   close(infile);
  864.  
  865.   assign(infile,'objdata.def');
  866.   reset(infile);
  867.   while not eof(infile) do
  868.     begin
  869.       readln(infile,hexstr,junk,graphstr,junk,name20);
  870.       objnames[str_to_hex(hexstr)]:= name20;
  871.       objgraph[str_to_hex(hexstr)]:= graphstr;
  872.     end;
  873.   close(infile);
  874.  
  875. end;
  876.  
  877. var gd,gm,
  878.     i,j,x,y   : integer;
  879.     infile    : text;
  880.     level     : word;
  881.     oldx,oldy : integer;
  882.     done      : boolean;
  883.     outstr,
  884.     tempstr   : string;
  885.  
  886.     legendpos : integer;
  887.     legendtype: integer;
  888.     newj        : integer;
  889.     currenttype,
  890.     currentval: integer;
  891.  
  892.     oldj,oldi : integer;
  893.  
  894.     key       : char;
  895.     control   : boolean;
  896.  
  897. begin
  898.   clrscr;
  899.   initialize;
  900.   directvideo:=false;
  901.   read_levels;
  902.  
  903.   gd:= vga;
  904.   gm:= vgahi;
  905.   initgraph(gd,gm,'');
  906.  
  907.   settextstyle(0,0,1);
  908.   mreset(themouse);
  909.  
  910.   show_objects:= true;
  911.   show_floor:= false;
  912.  
  913.   x:= port[$3da];
  914.   port[$3c0]:= 0;
  915.  
  916.   setfillstyle(1,7);
  917.   bar(0,0,64*7+MAP_X+4,64*7+MAP_Y+4);
  918.   bar(64*7+MAP_X+9,0,639,380);
  919.   setfillstyle(1,0);
  920.   bar(2,2,64*7+MAP_X+2,64*7+MAP_Y+2);
  921.   bar(64*7+MAP_X+11,2,637,380-28);
  922.   bar(64*7+MAP_X+11,380-25,637,378);
  923.   setcolor(15);
  924.   outtextxy(64*7+MAP_X+15,380-16,' MAP  OBJ  UP  DOWN');
  925.   setfillstyle(1,7);
  926.   bar(64*7+MAP_X+11+043,380-25,64*7+MAP_X+11+044,378);
  927.   bar(64*7+MAP_X+11+083,380-25,64*7+MAP_X+11+084,378);
  928.   bar(64*7+MAP_X+11+113,380-25,64*7+MAP_X+11+114,378);
  929.  
  930.   legendpos:= 0;
  931.   legendtype:= 0;
  932.   currenttype:= 0;
  933.   currentval:= 1;
  934.   setfillstyle(1,0);
  935.  
  936.   bar(66*7+MAP_X,60*7+MAP_Y,637,61*7+MAP_Y);
  937.   if currenttype=0 then
  938.     begin
  939.       output(66,60,mapgraph[currentval]);
  940.       outtext(67,60,15,' - '+mapnames[currentval]);
  941.     end
  942.   else
  943.     begin
  944.       output(66,60,objgraph[currentval]);
  945.       outtext(67,60,15,' - '+objnames[currentval]);
  946.     end;
  947.  
  948.   showlegend(legendtype,legendpos,25);
  949.  
  950.   x:= port[$3da];
  951.   port[$3c0]:= 32;
  952.   mshow;
  953.   level:=1;
  954.   done:= false;
  955.   repeat
  956.     mhide;
  957.     setfillstyle(1,0);
  958.     bar(5,TEXTLOC,64*7-1+MAP_X,477);
  959.     setcolor(15);
  960.     outtextxy(5,TEXTLOC,maps[level].name);
  961.     expand(maps[level].map,levelmap);
  962.     expand(maps[level].objects,objectmap);
  963.     display_map;
  964.     mshow;
  965.     oldx:= 0;
  966.     oldy:= 0;
  967.     key:= #0;
  968.     repeat
  969.       repeat
  970.         mpos(mouseloc);
  971.         x:= mouseloc.column;
  972.         y:= mouseloc.row;
  973.       until (oldx<>x) or (oldy<>y) or keypressed or (mouseloc.buttonstatus<>0);
  974.       oldx:= x;
  975.       oldy:= y;
  976.       if (mouseloc.buttonstatus<>0) then
  977.         begin
  978.           if inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y) then
  979.             begin
  980.               mhide;
  981.               repeat
  982.                 i:= (x - MAP_X) div 7;
  983.                 j:= (y - MAP_Y) div 7;
  984.                 if currenttype=0 then
  985.                   levelmap[i,j]:= currentval
  986.                 else
  987.                   objectmap[i,j]:= currentval;
  988.                 setfillstyle(1,0);
  989.                 dobar(i*7,j*7,i*7+6,j*7+6);
  990.                 if show_floor then
  991.                   output(i,j,mapgraph[levelmap[i,j]])
  992.                 else
  993.                   if not (levelmap[i,j] in [$6a..$8f]) then
  994.                     output(i,j,mapgraph[levelmap[i,j]]);
  995.                 if show_objects then
  996.                   output(i,j,objgraph[objectmap[i,j]]);
  997.                 mpos(mouseloc);
  998.                 x:= mouseloc.column;
  999.                 y:= mouseloc.row;
  1000.               until (not inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y)) or
  1001.                     (mouseloc.buttonstatus=0);
  1002.               mshow;
  1003.             end;
  1004.           if inside(464,355,506,378,x,y) then
  1005.             begin
  1006.               wait_for_mouserelease;
  1007.               legendpos:= 0;
  1008.               legendtype:= 0;
  1009.               showlegend(legendtype,legendpos,25);
  1010.             end;
  1011.           if inside(509,355,546,378,x,y) then
  1012.             begin
  1013.               wait_for_mouserelease;
  1014.               legendpos:= 0;
  1015.               legendtype:= 1;
  1016.               showlegend(legendtype,legendpos,25);
  1017.             end;
  1018.           if inside(549,355,576,378,x,y) then
  1019.             begin
  1020.               wait_for_mouserelease;
  1021.               dec(legendpos,25);
  1022.               if legendpos<0 then legendpos:= 0;
  1023.               showlegend(legendtype,legendpos,25);
  1024.             end;
  1025.           if inside(579,355,637,378,x,y) then
  1026.             begin
  1027.               wait_for_mouserelease;
  1028.               inc(legendpos,25);
  1029.               if (legendpos+25)>279 then legendpos:= 279-25;
  1030.               showlegend(legendtype,legendpos,25);
  1031.             end;
  1032.         end;
  1033.       if inside(464,2,637,350,x,y) then
  1034.         begin
  1035.           mhide;
  1036.           j:= (y-2) div 14;
  1037.           setcolor(15);
  1038.           rectangle(465,j*14+2+1,636,j*14+2+12);
  1039.           repeat
  1040.             mpos(mouseloc);
  1041.             newj:= (mouseloc.row-2) div 14;
  1042.             if mouseloc.buttonstatus<>0 then
  1043.               begin
  1044.                 currenttype:= legendtype;
  1045.                 currentval:= legendpos+j;
  1046.                 setfillstyle(1,0);
  1047.                 bar(66*7+MAP_X,60*7+MAP_Y,637,61*7+MAP_Y);
  1048.                 if currenttype=0 then
  1049.                   begin
  1050.                     output(66,60,mapgraph[currentval]);
  1051.                     outtext(67,60,15,' - '+mapnames[currentval]);
  1052.                   end
  1053.                 else
  1054.                   begin
  1055.                     output(66,60,objgraph[currentval]);
  1056.                     outtext(67,60,15,' - '+objnames[currentval]);
  1057.                   end;
  1058.               end;
  1059.           until (newj<>j) or (mouseloc.column<464) or keypressed;
  1060.           setcolor(0);
  1061.           rectangle(465,j*14+2+1,636,j*14+2+12);
  1062.           mshow;
  1063.         end;
  1064.  
  1065.       if inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y) then
  1066.         begin
  1067.           i:= (x - MAP_X) div 7;
  1068.           j:= (y - MAP_Y) div 7;
  1069.           if (oldj<>j) or (oldi<>i) then
  1070.             begin
  1071.               outstr:= '(';
  1072.               str(i:2,tempstr);
  1073.               outstr:= outstr+tempstr+',';
  1074.               str(j:2,tempstr);
  1075.               outstr:= outstr+tempstr+')    map: '+hex(levelmap[i,j]);
  1076.               outstr:= outstr+' - '+mapnames[levelmap[i,j]];
  1077.               setfillstyle(1,0);
  1078.               setcolor(15);
  1079.               bar(100,TEXTLOC,64*7+MAP_X-1,479);
  1080.               outtextxy(100,TEXTLOC,outstr);
  1081.               outstr:= '        object: '+hex(objectmap[i,j])+' - '+objnames[objectmap[i,j]];
  1082.               outtextxy(100,TEXTLOC+10,outstr);
  1083.               oldj:= j;
  1084.               oldi:= i;
  1085.             end;
  1086.         end
  1087.       else
  1088.         begin
  1089.           mhide;
  1090.           setfillstyle(1,0);
  1091.       bar(100,TEXTLOC,440,479);
  1092.           mshow;
  1093.         end;
  1094.  
  1095.       if keypressed then
  1096.         begin
  1097.           control:= false;
  1098.           key:= readkey;
  1099.           if key=#0 then
  1100.             begin
  1101.               control:= true;
  1102.               key:= readkey;
  1103.             end;
  1104.           if control then
  1105.             case key of
  1106.               'H':
  1107.                 begin
  1108.                   freemem(maps[level].map.data,maps[level].map.size);
  1109.                   freemem(maps[level].objects.data,maps[level].objects.size);
  1110.                   compress(levelmap,maps[level].map);
  1111.                   compress(objectmap,maps[level].objects);
  1112.                   inc(level);
  1113.                 end;
  1114.               'P':
  1115.                 begin
  1116.                   freemem(maps[level].map.data,maps[level].map.size);
  1117.                   freemem(maps[level].objects.data,maps[level].objects.size);
  1118.                   compress(levelmap,maps[level].map);
  1119.                   compress(objectmap,maps[level].objects);
  1120.                   dec(level);
  1121.                 end;
  1122.             end
  1123.           else
  1124.             case key of
  1125.               'q','Q':
  1126.                    begin
  1127.                      done:= true;
  1128.                      freemem(maps[level].map.data,maps[level].map.size);
  1129.                      freemem(maps[level].objects.data,maps[level].objects.size);
  1130.                      compress(levelmap,maps[level].map);
  1131.                      compress(objectmap,maps[level].objects);
  1132.                    end;
  1133.               'c','C': clear_level(level);
  1134.               'o','O': begin
  1135.                          mhide;
  1136.                          show_objects:= not show_objects;
  1137.                          display_map;
  1138.                          mshow;
  1139.                        end;
  1140.               'f','F': begin
  1141.                          mhide;
  1142.                          show_floor:= not show_floor;
  1143.                          display_map;
  1144.                          if legendtype=0 then
  1145.                            showlegend(legendtype,legendpos,25);
  1146.                          mshow;
  1147.                        end;
  1148.             end;
  1149.         end;
  1150.     until done or (key in ['P','H']);
  1151.     if level=0 then level:=LEVELS;
  1152.     if level=(LEVELS+1) then level:=1;
  1153.   until done;
  1154.  
  1155.   setfillstyle(1,0);
  1156.   bar(0,TEXTLOC,639,479);
  1157.   setcolor(15);
  1158.   outtextxy(0,TEXTLOC,' Save the current levels to disk? (Y/N) ');
  1159.  
  1160.   repeat
  1161.     repeat until keypressed;
  1162.     key:= readkey;
  1163.     if key=#0 then
  1164.       begin
  1165.         key:= readkey;
  1166.         key:= #0;
  1167.       end;
  1168.   until key in ['y','Y','n','N'];
  1169.  
  1170.   if key in ['y','Y'] then write_levels;
  1171.   textmode(co80);
  1172.   writeln('MapEdit 4.1                 Copyright (c) 1992  Bill Kirby');
  1173.   writeln;
  1174.   writeln('This program is intended to be for your personal use only.');
  1175.   writeln('Distribution of any modified maps may be construed as a ');
  1176.   writeln('copyright violation by Apogee/ID.');
  1177.   writeln;
  1178. end.